home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tvdmx.exe / TVDMXHEX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-16  |  6.4 KB  |  232 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    tvDMXHEX  --Hexadecimal Data Editing Unit    }
  5. {    tvDMX     --data editing project        }
  6. {                            }
  7. {    Copyright (c) 1992  Randolph Beck        }
  8. {                P.O. Box  56-0487        }
  9. {                Orlando, FL 32856        }
  10. {                CIS:  72361,753        }
  11. {                            }
  12. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  13.  
  14. Unit tvDMXHEX;
  15.  
  16. {$V-,X+,O+,D-,B-,R- }
  17.  
  18. interface
  19.  
  20. uses Objects, Drivers, Views, Menus, App,
  21.      RSet, DmxGizma, tvDMX, StdDMX, tvDMXREP;
  22.  
  23.  
  24. const
  25.     _HexLabels  =  '  0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F   0123456789ABCDEF ';
  26.  
  27.     _HexInfo    =    ^A                               { show all zeroes }
  28.                    + '\HH\HH\HH\HH\HH\HH\HH\HH'       { hex byte display }
  29.                    + ^D + '-HH\HH\HH\HH\HH\HH\HH\HH'  {  of 16 bytes }
  30.                    + '\ \'                            { blank spaces }
  31.                    + ^P + char (-16)                  { position -16 bytes }
  32.                    + 'c'^V#0#0'c'^V#0#0'c'^V#0#0'c'^V#0#0  { 16 characters }
  33.                    + 'c'^V#0#0'c'^V#0#0'c'^V#0#0'c'^V#0#0  { Default Value }
  34.                    + 'c'^V#0#0'c'^V#0#0'c'^V#0#0'c'^V#0#0  {      is ZERO. }
  35.                    + 'c'^V#0#0'c'^V#0#0'c'^V#0#0'c'^V#0#0;
  36.  
  37.     HexLabels   :  string [length (_HexLabels)]  = _HexLabels;
  38.     HexInfo     :  string [length (_HexInfo)]    = _HexInfo;
  39.  
  40.  
  41. type
  42.     PDmxHexInd        = ^TDmxHexInd;
  43.     PDmxHex        = ^TDmxHex;
  44.     PDmxHexWin        = ^TDmxHexWin;
  45.     PDmxReportHexFile    = ^TDmxReportHexFile;
  46.  
  47.  
  48.       { hexadecimal record number indicator }
  49.     TDmxHexInd        =  OBJECT (TDmxRecInd)
  50.       procedure Draw;  VIRTUAL;
  51.     end;
  52.  
  53.  
  54.       { main tvDMX-editing view }
  55.     TDmxHex           =  OBJECT (TDmxEditor)
  56.       procedure EvaluateField;  VIRTUAL;
  57.     end;
  58.  
  59.  
  60.       { tvDMX-Window view }
  61.     TDmxHexWin        =  OBJECT (TDmxWindow)
  62.       constructor Init (var Bounds    : TRect;
  63.                             ATitle    : TTitleStr;
  64.                             ANumber   : integer;
  65.                         var AData;
  66.                             BSize     : longint);
  67.  
  68.       procedure InitDMX (ATemplate : string;  var AData;
  69.                          ALabels, ARecInd : PDmxLink;
  70.                          BSize   : longint);  VIRTUAL;
  71.  
  72.       function  NewRecInd (Len : integer)  : PDmxLink;  VIRTUAL;
  73.     end;
  74.  
  75.  
  76.       { tvDMX-Report object }
  77.     TDmxReportHexFile    =  OBJECT (TDmxReportFile)
  78.       function  RecNumStr (RecNum : integer) : string;  VIRTUAL;
  79.     end;
  80.  
  81.  
  82. const
  83.     RDmxHexInd    :  TStreamRec = (
  84.         ObjType:   cmDMX + 16;
  85.         VmtLink:   ofs (TypeOf (TDmxHexInd)^);
  86.         Load:      @TDmxHexInd.Load;
  87.         Store:     @TDmxHexInd.Store
  88.       );
  89.  
  90.     RDmxHex       :  TStreamRec = (
  91.         ObjType:   cmDMX + 17;
  92.         VmtLink:   ofs (TypeOf (TDmxHex)^);
  93.         Load:      @TDmxHex.Load;
  94.         Store:     @TDmxHex.Store
  95.       );
  96.  
  97.     RDmxHexWin    :  TStreamRec = (
  98.         ObjType:   cmDMX + 18;
  99.         VmtLink:   ofs (TypeOf (TDmxHexWin)^);
  100.         Load:      @TDmxHexWin.Load;
  101.         Store:     @TDmxHexWin.Store
  102.       );
  103.  
  104.  
  105.   procedure RegisterDMXHEX;
  106.  
  107.  
  108. implementation
  109.  
  110.  
  111.   { ══ TDmxHexInd ════════════════════════════════════════════════════════ }
  112.  
  113.  
  114. procedure TDmxHexInd.Draw;
  115. const bts  :  array [0..15] of char = '0123456789ABCDEF';
  116. var   A    :  string;
  117.       B    :  TDrawBuffer;
  118.       C    :  word;
  119. begin
  120.   C := GetColor (6);
  121.   MoveChar (B, ' ', C, Size.X);
  122.   With PDmxEditor (Link)^ do
  123.     A := '['
  124.        + bts [(CurrentRecord shr 12) and $0F]
  125.        + bts [(CurrentRecord shr  8) and $0F]
  126.        + bts [(CurrentRecord shr  4) and $0F]
  127.        + bts [CurrentRecord and $0F]
  128.        + bts [(CurrentField^.fieldnum + $0F) and $0F]
  129.        + ']';
  130.   While (length (A) > Size.X) and (A [2] = '0') do Delete (A,2,1);
  131.   If length (A) > Size.X then
  132.     MoveChar (B, showOVERFLOW, C, Size.X)
  133.    else
  134.     MoveStr (B [succ ((Size.X) - length (A)) shr 1], A, C);
  135.   WriteBuf (0, 0, Size.X, 1, B);
  136. end;
  137.  
  138.  
  139.   { ══ TDmxHex ═══════════════════════════════════════════════════════════ }
  140.  
  141.  
  142. procedure TDmxHex.EvaluateField;
  143. { entire record must be redrawn if one byte is changed }
  144. begin
  145.   If FieldAltered then ReDrawRecord := TRUE;
  146.   TDmxEditor.EvaluateField;
  147. end;
  148.  
  149.  
  150.   { ══ TDmxHexWin ════════════════════════════════════════════════════════ }
  151.  
  152.  
  153. constructor TDmxHexWin.Init (var Bounds   : TRect;
  154.                                  ATitle   : TTitleStr;
  155.                                  ANumber  : integer;
  156.                              var AData;
  157.                                  BSize    : longint);
  158. begin
  159.   TWindow.Init (Bounds, ATitle, ANumber);
  160.  
  161.   InitDMX (HexInfo, AData,
  162.            NewDmxLabels (HexLabels),
  163.            NewRecInd (6),
  164.            BSize);
  165.  
  166.   Options := Options or ofTileable;
  167.  
  168. end;
  169.  
  170.  
  171. procedure TDmxHexWin.InitDMX (ATemplate : string;  var AData;
  172.                               ALabels, ARecInd : PDmxLink; BSize : longint);
  173. var  R  : TRect;
  174. begin
  175.   GetExtent (R);
  176.   R.Grow (-1,-1);
  177.   Inc (R.A.Y, 2);
  178.  
  179.   Insert (New (PDmxHex, Init (ATemplate, AData, BSize, R,
  180.                               ALabels, ARecInd,
  181.                               StandardScrollBar (sbHorizontal+ sbHandleKeyboard),
  182.                               StandardScrollBar (sbVertical  + sbHandleKeyboard))));
  183. end;
  184.  
  185.  
  186. function  TDmxHexWin.NewRecInd (Len : integer)  : PDmxLink;
  187. begin
  188.   If Len <= 0 then
  189.     NewRecInd := nil
  190.    else
  191.     NewRecInd := New (PDmxHexInd, InitInsert (@Self, Len));
  192. end;
  193.  
  194.  
  195.   { ══ TDmxReportHexFile ═════════════════════════════════════════════════ }
  196.  
  197.  
  198. function  TDmxReportHexFile.RecNumStr (RecNum : integer) : string;
  199. const bts : array [0..15] of char = '0123456789ABCDEF';
  200. var   A   : string;
  201. begin
  202.   If (CurrentRecord >= DMX^.DataBlockSize div DMX^.RecordSize) then
  203.     A := '     '
  204.    else
  205.     begin
  206.     A := ' 0000';
  207.     If ((RecNum shr 12) and $0F > 0) then A [1] := bts [(RecNum shr 12) and $0F];
  208.     A [2] := bts [(RecNum shr  8) and $0F];
  209.     A [3] := bts [(RecNum shr  4) and $0F];
  210.     A [4] := bts [RecNum and $0F];
  211.     end;
  212.   RecNumStr := A;
  213. end;
  214.  
  215.  
  216.   { ══════════════════════════════════════════════════════════════════════ }
  217.  
  218.  
  219. procedure RegisterDMXHEX;
  220. begin
  221.   RegisterType (RDmxHexInd);
  222.   RegisterType (RDmxHex);
  223.   RegisterType (RDmxHexWin);
  224. end;
  225.  
  226.  
  227.   { ══════════════════════════════════════════════════════════════════════ }
  228.  
  229.  
  230.  
  231. End.
  232.